home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / redir.com / REDIR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-09  |  6.1 KB  |  179 lines
  1. {==========================}
  2. { Unit for I/O Redirection }
  3. { Richard Casey            }
  4. { CIS 72247,151            }
  5. {==========================}
  6.  
  7. {===========================================================================
  8.  
  9. This unit is used to redirect I/O to a specific file handle to a user
  10. specified file. Typically this would be used to redirect standard input
  11. or standard output (or both) before executing a program via the EXEC
  12. procedure.
  13.  
  14. Thanks to Mike Rubenstein (70205,1144) for the information on how to do this.
  15.  
  16. Thanks also to Neil Rubenking (72267,1531) for his EXECDEMO program.
  17.  
  18. Types:
  19.   None
  20.  
  21. Procedures:
  22.   RedirectInput   Redirect a handle to a file (input)
  23.   RedirectOutput  Redirect a handle to a file (output)
  24.   UnRedirect      Restore a handle to its previous state
  25.   ExecRedirect    Exec a program with I/O redirection
  26.                   without loading another copy of COMMAND.COM
  27.  
  28. Functions:
  29.   None
  30.  
  31. Revision History:
  32.  
  33.   1.0:  12/22/88  -  Initial version
  34.   2.0:  01/09/88  -  Replaced Redirect with RedirectInput & RedirectOutput
  35.                      Added ExecRedirect
  36.  
  37.  
  38. ===========================================================================}
  39. Unit Redir;
  40.  
  41. interface
  42.  
  43. uses
  44.   dos;
  45.  
  46. procedure RedirectInput(    Handle     : word;    {Handle to redirect     }
  47.                             Filename   : string;  {File to redirect from  }
  48.                         var SaveHandle : word);   {Copy of original handle}
  49.  
  50. procedure RedirectOutput(    Handle     : word;    {Handle to redirect     }
  51.                              Filename   : string;  {File to redirect to    }
  52.                          var SaveHandle : word);   {Copy of original handle}
  53.  
  54. procedure UnRedirect(Handle,                       {Handle to redirect}
  55.                      SaveHandle : word);           {Copy of original handle}
  56.  
  57. procedure ExecRedirect(    Command    : PathStr;   {Command to execute    }
  58.                            InputFile  : PathStr;   {Redirected input file }
  59.                            OutputFile : PathStr;   {Redirected output file}
  60.                        var Status     : word);     {DOS return code       }
  61.     { Use '' for InputFile and/or OutputFile to skip I/O redirection }
  62.  
  63. {==========================================================================}
  64.  
  65. implementation
  66.  
  67. procedure Redirect(    Handle   : word;      {Handle to redirect      }
  68.                        Filename : string;    {File to redirect from/to}
  69.                        IOtype   : byte;      {1 = input, 2 = output   }
  70.                    var SaveHandle : word);   {Copy of original handle }
  71.   var
  72.     f : file;
  73.     r : registers;
  74.     x : word;
  75.   begin
  76.     with r do begin
  77.  
  78.       SaveHandle:=$FFFF;
  79.  
  80.       assign(f,FileName);               { Open desired file }
  81.       {$I-}
  82.       case IOtype of
  83.         1 :  reset(f);
  84.         2 :  rewrite(f);
  85.         else exit;
  86.       end;
  87.       {$I+}
  88.       if IOResult<>0 then exit;
  89.  
  90.       AX:=$4500;                        { Save current value of Handle }
  91.       BX:=Handle;
  92.       MsDos(r);
  93.       if (Flags and fCarry)<>0 then exit;
  94.       x:=r.ax;
  95.  
  96.       AX:=$4600;                        { Assign file handle to Handle }
  97.       BX:=FileRec(f).Handle;
  98.       CX:=Handle;
  99.       MsDos(r);
  100.       if (Flags and fCarry)<>0 then exit;
  101.  
  102.       close(f);                         { Close file }
  103.       SaveHandle:=x;                    { Return saved value of Handle }
  104.     end;
  105.   end;
  106.  
  107. procedure RedirectInput(    Handle     : word;    {Handle to redirect     }
  108.                             Filename   : string;  {File to redirect from  }
  109.                         var SaveHandle : word);   {Copy of original handle}
  110.   begin
  111.     Redirect(Handle,Filename,1,SaveHandle);
  112.   end;
  113.  
  114. procedure RedirectOutput(    Handle     : word;    {Handle to redirect     }
  115.                              Filename   : string;  {File to redirect to    }
  116.                          var SaveHandle : word);   {Copy of original handle}
  117.   begin
  118.     Redirect(Handle,Filename,2,SaveHandle);
  119.   end;
  120.  
  121. procedure UnRedirect(Handle,                       {Handle to redirect}
  122.                      SaveHandle : word);           {Copy of original handle}
  123.   var
  124.     r : registers;
  125.   begin
  126.     with r do begin
  127.       AX:=$4600;                        { Assign saved value back to Handle }
  128.       BX:=SaveHandle;
  129.       CX:=Handle;
  130.       MsDos(r);
  131.       if (Flags and fCarry)<>0 then exit;
  132.  
  133.       AX:=$3E00;                        { Close saved value }
  134.       BX:=SaveHandle;
  135.       MsDos(r);
  136.     end;
  137.   end;
  138.  
  139. procedure ExecRedirect(    Command    : PathStr;   {Command to execute    }
  140.                            InputFile  : PathStr;   {Redirected input file }
  141.                            OutputFile : PathStr;   {Redirected output file}
  142.                        var Status     : word);     {DOS return code       }
  143.   var
  144.     Found       : PathStr;
  145.     SaveHandle0 : word;
  146.     SaveHandle1 : word;
  147.   begin
  148.     { Find Command }
  149.     {   Try COM, EXE, and BAT extensions }
  150.     {   First on current directory, then on the PATH }
  151.     Found := FSearch(Command+'.COM','');
  152.     if Found = '' then Found := FSearch(Command+'.EXE','');
  153.     if Found = '' then Found := FSearch(Command+'.BAT','');
  154.     if Found = '' then Found := FSearch(Command+'.COM', GetEnv('PATH'));
  155.     if Found = '' then Found := FSearch(Command+'.EXE', GetEnv('PATH'));
  156.     if Found = '' then Found := FSearch(Command+'.BAT', GetEnv('PATH'));
  157.     if Found = '' then begin
  158.       Status:=$FFFF;
  159.       exit;
  160.     end;
  161.     Found := FExpand(Found);
  162.     SwapVectors;
  163.     if Pos('.BAT',Found) > 0 then begin
  164.       if InputFile<>''  then InputFile :=' <'+InputFile;
  165.       if OutputFile<>'' then OutputFile:=' >'+OutputFile;
  166.       Exec(GetEnv('COMSPEC'),'/C '+Found+InputFile+OutputFile);
  167.     end else begin
  168.       if InputFile<>''  then RedirectInput(0,InputFile,SaveHandle0);
  169.       if OutputFile<>'' then RedirectOutput(1,OutputFile,SaveHandle1);
  170.       Exec(Found,'');
  171.       if InputFile<>''  then UnRedirect(0,SaveHandle0);
  172.       if OutputFile<>'' then UnRedirect(1,SaveHandle1);
  173.     end;
  174.     SwapVectors;
  175.     Status:=DOSError;
  176.   end;
  177.  
  178. end.
  179.